home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 6 / FM Towns Free Software Collection 6.iso / t_os / valc204 / valc204q / valc204q.bas next >
BASIC Source File  |  1993-07-08  |  28KB  |  1,176 lines
  1. '*********************************** ※A:\VALCREC\VALCREC.DAT記録処理追加。
  2. '* VALCALC.BAS Copyright A.OKUYAMA * FM-TOWNS 1H(6MB) 1992,11,22
  3. '*     ２～１６進 整数四則演算器   * F-BASIC386CP V2.1 L10 → QuickBASIC V4.5
  4. '* 1992, 1,23   Ver2.04 1993, 2,14 * ※グラフィック処理を削除しました。
  5. '*********************************** ※マウス処理を削除しました。
  6. MAIN: '***********************  初期設定  ***************************
  7.     ON ERROR GOTO ERRLOOP
  8.     CLEAR
  9.     TYPE VALC
  10.         REC AS STRING * 255
  11.         DUM AS STRING * 1
  12.     END TYPE
  13.     DIM D#(254, 2), P$(254), CAL%(254), A$(254), NISHIN$(254)
  14.     DIM DUM$(254), MPARTS%(254), VALC AS VALC
  15.     '***** ファイル入出力環境設定 *****
  16.     DIR$ = "A:\VALCREC\"
  17.     FILE$ = "VALCREC.DAT"
  18.     FTYPE% = 4
  19.     RECLEN = LEN(VALC)
  20.     VALC.DUM = CHR$(13)
  21.     VALCREC% = 0
  22.     '**********************************
  23.     FOR C = 1 TO 31
  24.         IF C / 4 = INT(C / 4) THEN NISHIN$(C) = "_"
  25.     NEXT C
  26.     SCREEN 0
  27.     WIDTH 80, 25
  28.     EFFICIENCY$ = ".0000000000000000"
  29. RECFILE:         '***** 過去の計算記録ファイルを開く *****
  30.     COLOR 6, 0
  31.     CLS
  32.     LOCATE 13, 8
  33.     PRINT USING "《&&ドライブにデータ用フロッピーを挿入しボタンを押してください。》"; DIR$
  34.     RECFILE = 0
  35. DRIVECK:
  36.     GOSUB PANEL
  37.     ON ERROR GOTO RECERR
  38.     I$ = INKEY$
  39.     IF I$ = "" THEN GOTO DRIVECK
  40.     EP = 1
  41.     GOSUB FOPEN
  42.     RECFILE = 1
  43.     CLOSE FONO%
  44.     ON ERROR GOTO 0
  45.     '****************************  スタート  ****************************
  46. START:
  47.     COLOR 0, 0
  48.     CLS 0
  49.     MEMOFLAG = 0
  50.     FW$ = I$
  51.     GOSUB PANEL                 '***** タイトル表示             *****
  52.     GOSUB COMMENT               '***** コメント表示             *****
  53.     COLOR 6
  54.     LOCATE 3, 1
  55.     PRINT "前 回 ＝";
  56.     GOSUB MEMOPRT               '***** 前回の式を表示する       *****
  57.     COLOR 6
  58.     GOSUB OUTP                  '***** 前回の計算結果を表示する *****
  59.     COLOR 7
  60.     PRINT "計算式＝";
  61.     IF S$ = "R" OR S$ = "r" THEN
  62.         S$ = ""
  63.         GOTO START2
  64.     END IF
  65.     GOSUB COMLCL                '***** コマンド・ライン消去     *****
  66. START2:
  67.     GOSUB COMLINE               '***** コマンド・ライン入力     *****
  68.     GOSUB COMMCLS               '***** コメント表示消去         *****
  69.     GOSUB STANDBY               '***** 変数を初期化する         *****
  70.     GOSUB DERIV                 '***** 数字と演算記号を抽出する *****
  71.     GOSUB CONV                  '***** １０進数に変換する       *****
  72.     GOSUB CALC                  '***** 式計算ルーチン           *****
  73.     GOSUB SUBPRT                '***** 計算経過を表示する       *****
  74.     GOSUB OUTP                  '***** 10･16･2進数計算結果表示  *****
  75.     GOSUB CONVOUT               '***** 3～15進数計算結果表示    *****
  76.     COLOR 2
  77.     PRINT "  《 ESC･BREAK キーで終了します。R,rで前回復活。他のキーは新入力になります。》": COLOR 7
  78.     CSRX% = 0
  79.     CSRY% = CSRLIN - 1
  80. STP:
  81.     S$ = INKEY$
  82.     GOSUB PANEL
  83.     IF S$ = "" THEN GOTO STP
  84.     IF S$ = "R" OR S$ = "r" THEN
  85.         MEMORY$ = FW$
  86.         GOSUB COMLCL
  87.         GOSUB APEND
  88.         GOTO START
  89.     END IF
  90.     IF S$ <> CHR$(27) THEN GOTO START
  91.     END
  92.  
  93. '********************************************************************
  94. STANDBY: '***** 変数を初期化する *****
  95.     TOTAL# = 0
  96.     CLASS = 0
  97.     CLMAX = 0
  98.     PARTS = 0
  99.     FOR C = 0 TO 254
  100.         D#(C, 0) = 0
  101.         D#(C, 1) = 0
  102.         D#(C, 2) = 0
  103.         CAL%(C) = 0
  104.         P$(C) = ""
  105.     NEXT C
  106. RETURN
  107. PANEL: '***** ０行目タイトル表示 *****
  108.     ON ERROR GOTO ERRLOOP
  109.     LOCATE 1, 1
  110.     COLOR 4
  111.     PRINT "        赤色は実数エラー箇所   　";
  112.     COLOR 3
  113.     PRINT "水色は虚数エラー箇所   　";
  114.     COLOR 5
  115.     PRINT "紫色は警告箇所        ";
  116.     LOCATE 2, 1
  117.     COLOR 0, 6
  118.     PRINT USING "  &        &  Ver2.04 "; DATE$;
  119.     COLOR 0, 2
  120.     PRINT " ２ ～ １６ 進 整 数 四 則 演 算 器 ";
  121.     COLOR 0, 6
  122.     PRINT USING " A.Okuyama  &      &  "; TIME$;
  123. RETURN
  124. COMMENT: '***** コメント表示 *****
  125.     LOCATE 13, 1
  126.     COLOR 2
  127.     PRINT "入力条件：各入力項が±1.797693134862315D+308以内。計算式の総桁数は255文字まで。"
  128.     COLOR 3
  129.     PRINT "　　　　　計算の都合上、10進数換算で小数点以下15桁未満を切り捨てます。"
  130.     PRINT "          各項の直後に＠マークに続けて２～16進数を指定してください。"
  131.     PRINT "          ただし、10進数の場合は省略できます。また16進数はH,hで代用できます。"
  132.     PRINT "          なお、省略10進数以外の小数点は０と見なすので注意が必要です。"
  133.     PRINT "          [{()}]*/+-^0123456789AaBbCcDdEeFf@HhGgLlMm[空白][ESC][削除][挿入]"
  134.     PRINT "          [BACK-SKIP]←↑↓→[RETURN][実行]RrXxの各キーが使えます。"
  135.     COLOR 2
  136.     PRINT "出力条件：－4294967295 ≦ 出 力 項 ≦ 4294967295 (FFFFFFFFh)"
  137.     COLOR 3
  138.     PRINT "          10進数以外は10進小数点以下の値を切り捨てます。"
  139.     COLOR 2
  140.     PRINT "入力方法：前回の各項はG(g)、式はL(l)、解はM(m)キーでカーソル位置に挿入します｡ "
  141.     COLOR 3
  142.     PRINT "   (例) 計算式＝-[-{FFH+fah*-10@16}-{56@7-12@4*(32-5*2)}/-40@6]-{42@7^5^(1/2)}";
  143. RETURN
  144. COMMCLS: '***** コメント表示消去 *****
  145.     CSRX% = POS(0)
  146.     CSRY% = CSRLIN
  147.     COLOR 7
  148.     FOR Y = 13 TO 24
  149.         LOCATE Y, 1
  150.         PRINT SPACE$(79);
  151.     NEXT Y
  152.     LOCATE CSRY%, CSRX%
  153. RETURN
  154. MEMOPRT: '********** 前回の式を表示する。**********
  155.     ON ERROR GOTO ERRLOOP
  156.     MEMOCSRX% = 9
  157.     MEMOCSRY% = 3
  158.     LOCATE MEMOCSRY%, MEMOCSRX%
  159.     FOR MC% = 0 TO PARTS
  160.         COLOR 6
  161.     IF CAL%(MC%) = 1 THEN PRINT "*";
  162.     IF CAL%(MC%) = 2 THEN PRINT "/";
  163.     IF CAL%(MC%) = 3 THEN PRINT "+";
  164.     IF CAL%(MC%) = 4 THEN PRINT "-";
  165.     IF CAL%(MC%) = 5 THEN PRINT "^";
  166.     IF CAL%(MC%) = 10 THEN PRINT "(";
  167.     IF CAL%(MC%) = -10 THEN PRINT ")";
  168.     IF D#(MC%, 2) <> 0 THEN COLOR 7 - D#(MC%, 2)
  169.     IF MC% = MPARTS%(MEMOCSX%) AND MEMOFLAG = 1 THEN
  170.         IF D#(MC%, 2) = 0 THEN
  171.             COLOR 0, 6
  172.         ELSE
  173.             COLOR 0, 7 - D#(MC%, 2)
  174.         END IF
  175.     END IF
  176.     PRINT P$(MC%);
  177.     NEXT MC%
  178.     PRINT
  179. RETURN
  180. '****************** コマンド・ライン入力ルーチン ********************
  181. COMLCL:
  182.     ON ERROR GOTO ERRLOOP
  183.     FOR C% = 0 TO 254
  184.         DUM$(C%) = ""
  185.     NEXT C%
  186. RETURN
  187. COMLINE:
  188.     ON ERROR GOTO ERRLOOP
  189.     CSRX% = POS(0)
  190.     CSRY% = CSRLIN
  191.     CSX% = 0
  192.     CSY% = 0
  193.     GOSUB PACK
  194.     COLOR 0, 3
  195.     GOSUB CPRT
  196.     COLOR 7
  197. INKEY: '********** 計算式入力ルーチン **********
  198.     GOSUB PANEL
  199.     ON ERROR GOTO ERRLOOP
  200.     K$ = INKEY$
  201.     IF K$ = "" THEN GOTO INKEY
  202.     IF (K$ = "R" OR K$ = "r") AND VALCREC% = 0 THEN
  203.         GOSUB PACK
  204.         GOSUB RECSET
  205.         COLOR 0, 3
  206.         GOSUB CPRT
  207.         GOTO INKEY
  208.     END IF
  209.     IF K$ = "G" OR K$ = "g" THEN
  210.         MEMOFLAG = 0
  211.         GOSUB MEMORY
  212.         MEMOFLAG = 1
  213.         MEMOCSX% = 0
  214.         GOSUB MEMOPRT
  215.         GOSUB MEMORY
  216.         PRINT
  217.         GOSUB PACK
  218.         GOSUB APEND
  219.         GOSUB PACK
  220.         COLOR 0, 3
  221.         GOSUB CPRT
  222.         COLOR 7
  223.         MEMOFLAG = 0
  224.         GOSUB MEMOPRT
  225.         GOTO INKEY
  226.     END IF
  227.     IF K$ = "L" OR K$ = "l" THEN
  228.         IF FW$ <> "" THEN
  229.             MEMORY$ = FW$
  230.             GOSUB PACK
  231.             GOSUB APEND
  232.             GOSUB PACK
  233.             COLOR 0, 3
  234.             GOSUB CPRT
  235.             COLOR 7
  236.             GOTO INKEY
  237.         END IF
  238.     END IF
  239.     IF K$ = "M" OR K$ = "m" THEN
  240.         IF ER = 0 THEN
  241.             GOSUB REPLY
  242.             GOSUB PACK
  243.             GOSUB APEND
  244.             GOSUB PACK
  245.             COLOR 0, 3
  246.             GOSUB CPRT
  247.             COLOR 7
  248.             GOTO INKEY
  249.         ELSE
  250.             GOTO INKEY
  251.         END IF
  252.     END IF
  253.     IF K$ = CHR$(0) + CHR$(77) THEN   '→CHR$(28)
  254.         COLOR 7
  255.         GOSUB CPRT
  256.         GOSUB RIGHT
  257.         COLOR 0, 3
  258.         GOSUB CPRT
  259.         GOTO INKEY
  260.     END IF
  261.     IF K$ = CHR$(0) + CHR$(75) THEN   '←CHR$(29)
  262.         COLOR 7
  263.         GOSUB CPRT
  264.         GOSUB LEFT
  265.         COLOR 0, 3
  266.         GOSUB CPRT
  267.         GOTO INKEY
  268.     END IF
  269.     IF K$ = CHR$(0) + CHR$(72) THEN   '↑CHR$(30)
  270.         COLOR 7
  271.         GOSUB CPRT
  272.         GOSUB UP
  273.         COLOR 0, 3
  274.         GOSUB CPRT
  275.         GOTO INKEY
  276.     END IF
  277.     IF K$ = CHR$(0) + CHR$(80) THEN   '↓CHR$(31)
  278.         COLOR 7
  279.         GOSUB CPRT
  280.         GOSUB DOWN
  281.         COLOR 0, 3
  282.         GOSUB CPRT
  283.         GOTO INKEY
  284.     END IF
  285.     IF K$ = CHR$(8) THEN              'BACK SPACE
  286.         GOSUB PACK
  287.         COLOR 0, 3
  288.         GOSUB CPRT
  289.         COLOR 7
  290.         GOTO INKEY
  291.     END IF
  292.     IF K$ = CHR$(13) THEN             'RETURN
  293.         GOSUB PACK
  294.         RETURN
  295.     END IF
  296.     IF K$ = CHR$(27) THEN END         'ESC
  297.     IF K$ = CHR$(0) + CHR$(82) THEN   '挿入CHR$(18)
  298.         GOSUB INS
  299.         GOTO INKEY
  300.     END IF
  301.     IF K$ = CHR$(0) + CHR$(83) OR K$ = " " THEN '削除CHR$(&H7F)
  302.         GOSUB DEL
  303.         COLOR 0, 3
  304.         GOSUB CPRT
  305.         COLOR 7
  306.         GOTO INKEY
  307.     END IF
  308.     IF &H27 < ASC(K$) AND ASC(K$) < &H3A AND K$ <> "'" AND K$ <> "," THEN
  309.         DUM$(CSX%) = K$
  310.         COLOR 7
  311.         GOSUB CPRT
  312.         GOSUB RIGHT
  313.         COLOR 0, 3
  314.         GOSUB CPRT
  315.         GOTO INKEY
  316.     END IF
  317.     IF &H3F < ASC(K$) AND ASC(K$) < &H49 THEN
  318.         DUM$(CSX%) = K$
  319.         COLOR 7
  320.         GOSUB CPRT
  321.         GOSUB RIGHT
  322.         COLOR 0, 3
  323.         GOSUB CPRT
  324.         GOTO INKEY
  325.     END IF
  326.     IF &H60 < ASC(K$) AND ASC(K$) < &H69 THEN
  327.         DUM$(CSX%) = K$
  328.         COLOR 7
  329.         GOSUB CPRT
  330.         GOSUB RIGHT
  331.         COLOR 0, 3
  332.         GOSUB CPRT
  333.         GOTO INKEY
  334.     END IF
  335.     IF K$ = "[" OR K$ = "]" OR K$ = "^" OR K$ = "{" OR K$ = "}" THEN
  336.         DUM$(CSX%) = K$
  337.         COLOR 7
  338.         GOSUB CPRT
  339.         GOSUB RIGHT
  340.         COLOR 0, 3
  341.         GOSUB CPRT
  342.         GOTO INKEY
  343.     ELSE
  344.         GOTO INKEY
  345.     END IF
  346. RIGHT: '***** カーソルを右へ移動する。 *****
  347.     IF CSX% < 254 THEN CSX% = CSX% + 1
  348. RETURN
  349. LEFT: '***** カーソルを左へ移動する。 *****
  350.     IF 0 < CSX% THEN CSX% = CSX% - 1
  351. RETURN
  352. UP: '***** カーソルを上へ移動する。 *****
  353.     IF 0 <= CSX% - 80 THEN CSX% = CSX% - 80
  354. RETURN
  355. DOWN: '***** カーソルを下へ移動する。 *****
  356.     IF CSX% + 80 <= 254 THEN CSX% = CSX% + 80
  357. RETURN
  358. CPRT: '***** カーソルを表示する。*****
  359. ON ERROR GOTO ERRLOOP
  360.     CSY% = CSRY% + INT((CSRX% + CSX% - 1) / 80)
  361.     LOCATE CSY%, CSRX% + CSX% - INT((CSRX% + CSX% - 1) / 80) * 80
  362.     IF DUM$(CSX%) = "" THEN
  363.         PRINT " "
  364.     ELSE
  365.         PRINT DUM$(CSX%)
  366.     END IF
  367. RETURN
  368. PACK: '***** 計算式を文字詰めする。*****
  369.     ON ERROR GOTO ERRLOOP
  370.     I$ = ""
  371.     CSC% = 0 '***** CSC%=LEN(I$)
  372.     FOR C% = 1 TO 255
  373.         I$ = I$ + DUM$(C% - 1)
  374.         IF DUM$(C% - 1) <> "" THEN
  375.             CSC% = CSC% + 1
  376.             DUM$(C% - 1) = ""
  377.         END IF
  378.         IF C% = CSX% AND 0 < CSX% THEN CSX% = CSC%
  379.         IF CSX% < 0 THEN CSX% = 0
  380.     NEXT C%
  381.     FOR C% = 1 TO LEN(I$)
  382.         DUM$(C% - 1) = MID$(I$, C%, 1)
  383.     NEXT C%
  384.     LOCATE CSRY%, CSRX%
  385.     COLOR 7
  386.     FOR C% = 1 TO 255
  387.         PRINT " ";
  388.     NEXT C%
  389.     LOCATE CSRY%, CSRX%
  390.     COLOR 7
  391.     IF LEN(I$) = 0 THEN GOTO PACKJP
  392.     FOR C% = 1 TO LEN(I$)
  393.         PRINT MID$(I$, C%, 1);
  394.     NEXT C%
  395. PACKJP:
  396.     PRINT
  397. RETURN
  398. APEND: '***** 選択したMEMORY$を計算式のカーソル位置に挿入する。*****
  399.     ON ERROR GOTO ERRLOOP
  400.     SUBI$ = ""
  401.     IF CSX% = 0 THEN GOTO APJP1
  402.     FOR MC% = 0 TO CSX% - 1
  403.         SUBI$ = SUBI$ + DUM$(MC%)
  404.     NEXT MC%
  405. APJP1:
  406.     IF LEN(SUBI$) = 255 THEN GOTO APJP2
  407.     SUBI$ = SUBI$ + LEFT$(MEMORY$, 255 - LEN(SUBI$))
  408.     FOR MC% = CSX% TO 254
  409.         IF LEN(SUBI$) + LEN(DUM$(MC%)) <= 255 THEN SUBI$ = SUBI$ + DUM$(MC%)
  410.     NEXT MC%
  411. APJP2:
  412.     IF LEN(SUBI$) = 0 THEN RETURN
  413.     FOR MC% = 1 TO LEN(SUBI$)
  414.         DUM$(MC% - 1) = MID$(SUBI$, MC%, 1)
  415.     NEXT MC%
  416. RETURN
  417. DEL: '***** 計算式のカーソル位置の１文字を削除する。*****
  418.     ON ERROR GOTO ERRLOOP
  419.     DUM$(CSX%) = ""
  420.     COLOR 7
  421.     GOSUB CPRT
  422.     GOSUB RIGHT
  423.     IF K$ = " " THEN RETURN '***** K$が空白ならば文字詰めしない。
  424.     GOSUB PACK
  425. RETURN
  426. INS: '***** 計算式のカーソル位置に空白を挿入する。*****
  427.     ON ERROR GOTO ERRLOOP
  428.     IF CSX% = 254 THEN GOTO INSJP
  429.     FOR C% = 254 TO CSX% + 1 STEP -1
  430.         DUM$(C%) = DUM$(C% - 1)
  431.     NEXT C%
  432. INSJP:
  433.     DUM$(CSX%) = ""
  434.     COLOR 7
  435.     LOCATE CSRY%, CSRX%
  436.     FOR C% = 1 TO 255
  437.         IF DUM$(C% - 1) = "" THEN
  438.             PRINT " ";
  439.         ELSE
  440.             PRINT DUM$(C% - 1);
  441.         END IF
  442.     NEXT C%
  443.     COLOR 0, 3
  444.     GOSUB CPRT
  445.     COLOR 7
  446. RETURN
  447. RECSET: '********** DIR$ + FILE$ に記録した式を読み出す **********
  448.     ON ERROR GOTO 0
  449.     IF RECFILE = 0 THEN RETURN
  450.     NEWREC$ = I$
  451.     GOSUB FOPEN
  452.     IF DNOMAX < 4000 THEN
  453.         DNO = DNOMAX + 1
  454.     ELSE
  455.         DNO = DNOMAX
  456.     END IF
  457.     IF DNOMAX = 0 THEN GOTO RECRW
  458. RECLOOP: '***** 選択処理 *****
  459.     IF DNO <= DNOMAX THEN
  460.         GET FONO%, DNO, VALC
  461.     ELSE
  462.         VALC.REC = NEWREC$
  463.     END IF
  464.     READREC$ = ""
  465.     RECP$ = ""
  466.     FOR COLUM = 1 TO 255
  467.         RECP$ = MID$(VALC.REC, COLUM, 1)
  468.         IF RECP$ <> " " THEN READREC$ = READREC$ + RECP$
  469.     NEXT COLUM
  470.     COLOR 7
  471.     LOCATE CSRY%, 1
  472.     PRINT USING "録####＝"; DNO;
  473.     COLOR 0, 3
  474.     IF LEN(READREC$) = 0 THEN GOTO RECPRT1
  475.     FOR C% = 1 TO LEN(READREC$)
  476.         PRINT MID$(READREC$, C%, 1);
  477.     NEXT C%
  478. RECPRT1:
  479.     COLOR 7
  480.     IF 255 <= C% THEN GOTO RECPRTJP
  481.     FOR CC% = C% TO 255
  482.         PRINT " ";
  483.     NEXT CC%
  484. RECPRTJP:
  485. RECINK: '***** 選択入力 *****
  486.     GOSUB PANEL
  487.     I$ = INKEY$
  488.     IF I$ = "" THEN GOTO RECINK
  489.     IF I$ = CHR$(0) + CHR$(75) OR I$ = CHR$(0) + CHR$(72) THEN DNO = DNO - 1  '←↑
  490.     IF I$ = CHR$(0) + CHR$(77) OR I$ = CHR$(0) + CHR$(80) THEN DNO = DNO + 1  '→↓
  491.     IF I$ = CHR$(0) + CHR$(82) OR I$ = CHR$(27) THEN GOTO EORECSET
  492.     IF (I$ = "X" OR I$ = "x") AND NEWREC$ <> "" THEN GOSUB RECXCHG
  493.     IF I$ = CHR$(13) THEN GOTO RECRW
  494.     IF DNO < 1 THEN DNO = DNOMAX + 1
  495.     IF DNOMAX + 1 < DNO THEN DNO = 1
  496.     GOTO RECLOOP
  497. RECRW: '***** DIR$ + FILE$ 書き込み *****
  498.     IF DNOMAX < DNO AND 0 < LEN(NEWREC$) THEN
  499.         VALC.REC = NEWREC$
  500.         I$ = NEWREC$
  501.         PUT FONO%, DNO, VALC
  502.     END IF
  503.     IF DNO <= DNOMAX THEN
  504.         VALC.REC = READREC$
  505.         I$ = READREC$
  506.     END IF
  507.     FOR C% = 1 TO 255
  508.         DUM$(C% - 1) = MID$(I$, C%, 1)
  509.     NEXT C%
  510. EORECSET: '***** 選択処理終了 *****
  511.     COLOR 7
  512.     LOCATE CSRY%, 1
  513.     PRINT "計算式＝";
  514.     CLOSE FONO%
  515.     GOSUB PACK
  516. RETURN
  517. RECXCHG: '***** 記録データの入替え *****
  518.     IF DNOMAX < DNO THEN
  519.         VALC.REC = READREC$
  520.     ELSE
  521.         VALC.REC = NEWREC$
  522.     END IF
  523.     DNOMAX = DNO - 1
  524. RETURN
  525. '********************* 前回メモリー選択ルーチン *********************
  526. REPLY: '***** 前回の解を指定するメモリー処理（指数表記を改める）*****
  527.     MEMORY$ = ""
  528.     FOR C% = 1 TO LEN(STR$(TOTAL#))
  529.         DUM$ = MID$(STR$(TOTAL#), C%, 1)
  530.         IF DUM$ = "D" THEN
  531.             MEMORY$ = "(" + MEMORY$ + "*10^(" + RIGHT$(STR$(TOTAL#), 4) + "))"
  532.             C% = LEN(STR$(TOTAL#))
  533.             GOTO REPLYJP
  534.         END IF
  535.         MEMORY$ = MEMORY$ + DUM$
  536. REPLYJP:
  537.     NEXT C%
  538. RETURN
  539. MEMORY: '***** 前回の項を指定するメモリー処理 *****
  540.     ON ERROR GOTO ERRLOOP
  541.     MEMOCSX% = 0
  542.     MEMOPARTS% = 0
  543.     FOR MC% = 0 TO PARTS
  544.         IF P$(MC%) <> "" THEN
  545.             MPARTS%(MEMOPARTS%) = MC%
  546.             MEMOPARTS% = MEMOPARTS% + 1
  547.         END IF
  548.         IF MEMOFLAG = 0 AND MEMOCSX% = 0 AND P$(MC%) <> "" THEN
  549.             MEMOCSX% = MC%
  550.         END IF
  551.     NEXT MC%
  552.     MEMORY$ = P$(MPARTS%(MEMOCSX%))
  553.     IF MEMOPARTS% = 0 OR MEMOFLAG = 0 THEN RETURN
  554. MEMOINKEY: '***** 前回の式の項を指定する。*****
  555.     ON ERROR GOTO ERRLOOP
  556.     GOSUB PANEL
  557.     MEM$ = INKEY$
  558.     IF MEM$ = "" THEN GOTO MEMOINKEY
  559.     IF MEM$ = CHR$(0) + CHR$(77) THEN
  560.         GOSUB MEMORIGHT
  561.         GOSUB MEMOPRT
  562.         GOTO MEMOINKEY
  563.     END IF
  564.     IF MEM$ = CHR$(0) + CHR$(75) THEN
  565.         GOSUB MEMOLEFT
  566.         GOSUB MEMOPRT
  567.         GOTO MEMOINKEY
  568.     END IF
  569.     IF MEM$ = CHR$(0) + CHR$(82) OR MEM$ = CHR$(27) THEN
  570.         MEMORY$ = ""
  571.         PRINT
  572.         RETURN
  573.     END IF
  574.     IF MEM$ = CHR$(13) THEN
  575.         GOSUB MEMOPRT
  576.         RETURN
  577.     END IF
  578.     GOTO MEMOINKEY
  579. MEMORIGHT: '***** 前回の式の中で、現在の指定よりも一つ右の項 *****
  580.     ON ERROR GOTO ERRLOOP
  581.     IF MEMOCSX% < MEMOPARTS% - 1 THEN
  582.         MEMOCSX% = MEMOCSX% + 1
  583.         MEMORY$ = P$(MPARTS%(MEMOCSX%))
  584.     END IF
  585. RETURN
  586. MEMOLEFT: '***** 前回の式の中で、現在の指定よりも一つ左の項 *****
  587.     ON ERROR GOTO ERRLOOP
  588.     IF 0 < MEMOCSX% THEN
  589.         MEMOCSX% = MEMOCSX% - 1
  590.         MEMORY$ = P$(MPARTS%(MEMOCSX%))
  591.     END IF
  592. RETURN
  593. '************************* 式評価ルーチン ***************************
  594. '***** 数字("P$(PARTS)")と演算記号("CAL%(PARTS)")を抽出する。*****
  595. DERIV:
  596.     ON ERROR GOTO ERRLOOP
  597.     FOR X = 1 TO LEN(I$)
  598.         A$ = MID$(I$, X, 1)
  599.         IF A$ = "(" OR A$ = "[" OR A$ = "{" THEN
  600.             PARTS = PARTS + 1
  601.             CLASS = CLASS + 1
  602.             CAL%(PARTS) = 10
  603.             CLMAX = CLMAX + 1
  604.             GOTO DVJP1
  605.         END IF
  606.         IF A$ = ")" OR A$ = "]" OR A$ = "}" THEN
  607.             PARTS = PARTS + 1
  608.             CLASS = CLASS - 1
  609.             CAL%(PARTS) = -10
  610.             GOTO DVJP1
  611.         END IF
  612.         IF A$ = "*" THEN
  613.             PARTS = PARTS + 1
  614.             CAL%(PARTS) = 1
  615.             GOTO DVJP1
  616.         END IF
  617.         IF A$ = "/" THEN
  618.             PARTS = PARTS + 1
  619.             CAL%(PARTS) = 2
  620.             GOTO DVJP1
  621.         END IF
  622.         IF A$ = "+" THEN
  623.             IF P$(PARTS) = "" AND CAL%(PARTS) <> -10 THEN
  624.                 P$(PARTS) = "1"
  625.                 PARTS = PARTS + 1
  626.                 CAL%(PARTS) = 1 + (CAL%(PARTS - 1) = 3)
  627.                 TEMPCAL% = CAL%(PARTS - 1) - INT(CAL%(PARTS - 1) / 10) * 10
  628.                 CAL%(PARTS) = CAL%(PARTS) + INT(TEMPCAL% / 2) * (CAL%(PARTS - 1) AND 2) / 2
  629.                 GOTO DVJP1
  630.             ELSE
  631.                 PARTS = PARTS + 1
  632.                 CAL%(PARTS) = 3
  633.                 GOTO DVJP1
  634.             END IF
  635.         END IF
  636.         IF A$ = "-" THEN
  637.             IF P$(PARTS) = "" AND CAL%(PARTS) <> -10 THEN
  638.                 P$(PARTS) = "-1"
  639.                 PARTS = PARTS + 1
  640.                 CAL%(PARTS) = 1 + (CAL%(PARTS - 1) = 3)
  641.                 TEMPCAL% = CAL%(PARTS - 1) - INT(CAL%(PARTS - 1) / 10) * 10
  642.                 CAL%(PARTS) = CAL%(PARTS) + INT(TEMPCAL% / 2) * (CAL%(PARTS - 1) AND 2) / 2
  643.                 GOTO DVJP1
  644.             ELSE
  645.                 PARTS = PARTS + 1
  646.                 CAL%(PARTS) = 4
  647.                 GOTO DVJP1
  648.             END IF
  649.         END IF
  650.         IF A$ = "^" THEN
  651.             PARTS = PARTS + 1
  652.             CAL%(PARTS) = 5
  653.             GOTO DVJP1
  654.         END IF
  655.         P$(PARTS) = P$(PARTS) + A$
  656. DVJP1:
  657.     NEXT X
  658. RETURN
  659. '***** 数字("P$(COUNT)")を１０進数("D#(COUNT,0)")に変換する。******
  660. CONV:
  661.     ON ERROR GOTO ERRLOOP
  662.     ER = 0
  663.     FOR COUNT = 0 TO PARTS
  664.         P$ = ""
  665.         FOR X = 1 TO LEN(P$(COUNT))
  666.             A$ = MID$(P$(COUNT), X, 1)
  667.             IF A$ = "@" THEN
  668.                 SHIN# = VAL(RIGHT$(P$(COUNT), LEN(P$(COUNT)) - X))
  669.                 GOTO HENKAN
  670.             END IF
  671.             IF A$ = "H" OR A$ = "h" THEN
  672.                 SHIN# = 16
  673.                 GOTO HENKAN
  674.             END IF
  675.             P$ = P$ + A$
  676.         NEXT X
  677.         IF VAL(P$) = INT(VAL(P$)) THEN
  678.             P$ = P$ + LEFT$(EFFICIENCY$, 255 - LEN(P$))
  679.         ELSE
  680.             P$ = P$ + MID$(EFFICIENCY$, 2, 255 - LEN(P$))
  681.         END IF
  682.         D#(COUNT, 0) = VAL(P$)
  683.         GOTO DERIVJP2
  684. HENKAN:
  685.         A# = 0
  686.         IF P$ = "" THEN
  687.             D#(COUNT, 2) = 3
  688.             ER = 1
  689.             GOTO ERJP
  690.         END IF
  691.         FOR C = 0 TO X - 2
  692.             A$(C) = MID$(P$, C + 1, 1) + EFFICIENCY$
  693.             ATEMP# = ASC(A$(C))
  694.             A# = A# + SHIN# ^ (X - C - 2) * (VAL(A$(C)) + INT(ATEMP# / 65) * (ATEMP# - 55) * ABS(INT(ATEMP# / 71) - 1) + INT(ATEMP# / 97) * (ATEMP# - 87)) * ABS(INT(ATEMP# / 103) - 1)
  695.             IF SHIN# <= (VAL(A$(C)) + INT(ATEMP# / 65) * (ATEMP# - 55) * ABS(INT(ATEMP# / 71) - 1) + INT(ATEMP# / 97) * (ATEMP# - 87)) * ABS(INT(ATEMP# / 103) - 1) THEN
  696.                 D#(COUNT, 2) = 3
  697.                 ER = 1
  698.             END IF
  699.         NEXT C
  700. ERJP:
  701.         D#(COUNT, 0) = A#
  702. DERIVJP2:
  703.     NEXT COUNT
  704.     PRINT "　　　＝";
  705.     FOR C = 0 TO PARTS
  706.         IF CAL%(C) = 1 THEN PRINT "*";
  707.         IF CAL%(C) = 2 THEN PRINT "/";
  708.         IF CAL%(C) = 3 THEN PRINT "+";
  709.         IF CAL%(C) = 4 THEN PRINT "-";
  710.         IF CAL%(C) = 5 THEN PRINT "^";
  711.         IF CAL%(C) = 10 THEN PRINT "(";
  712.         IF CAL%(C) = -10 THEN PRINT ")";
  713.         COLOR 7 - D#(C, 2)
  714.         PRINT P$(C);
  715.         COLOR 7
  716.     NEXT C
  717.     PRINT
  718. RETURN
  719. '************************** 演算ルーチン ****************************
  720. CIRCUM: '***** 各項のべき乗の連なりをチェックし、演算する。 *****
  721.     ON ERROR GOTO ERRLOOP
  722.     SSUBTOTAL# = D#(C, 0)
  723.     CC = C
  724.     CKCIRC = 0
  725.     ENDCIRC = C
  726.     IF FLAGOFF - 1 <= C THEN
  727.         D#(C, 1) = 1
  728.         RETURN
  729.     END IF
  730. CIRCUM1:
  731.     CC = CC + 1
  732.     IF CC = FLAGOFF THEN GOTO CIRCUM2
  733.     IF D#(CC, 1) = 1 THEN GOTO CIRCUM1   '***** 計算済みの項を読み飛ばす *****
  734.     IF CAL%(CC) = 5 THEN
  735.         CKCIRC = CKCIRC + 1
  736.         ENDCIRC = CC
  737.         GOTO CIRCUM1
  738.     END IF
  739. CIRCUM2:
  740.     IF CKCIRC = 0 THEN '***** べき乗が連なっていない *****
  741.         D#(C, 1) = 1
  742.         RETURN
  743.     END IF
  744.     SSUBTOTAL# = D#(ENDCIRC, 0)
  745.     D#(ENDCIRC, 1) = 1
  746.     CKCIRC = ENDCIRC
  747.     CIRCERR = 0
  748.     FOR CIRC = ENDCIRC - 1 TO C STEP -1
  749.         ON ERROR GOTO ERRLOOP
  750.         SSSUBTOTAL# = SSUBTOTAL#
  751.         IF D#(CIRC, 1) = 1 THEN GOTO CIRCUM4 '***** 計算済みの項を読み飛ばす *****
  752.         IF D#(CIRC, 0) = 1 THEN
  753.             SSUBTOTAL# = 1
  754.             CIRCERR = 0
  755.             GOTO CIRCUM3
  756.         END IF
  757.         IF D#(CIRC, 0) = 0 THEN
  758.             IF SSUBTOTAL# < 0 THEN
  759.                 CIRCERR = 0
  760.             ELSE
  761.                 SSUBTOTAL# = 0
  762.                 D#(CIRC, 1) = 1
  763.                 CIRCERR = 0
  764.                 GOTO CIRCUM3
  765.             END IF
  766.         END IF
  767.         IF CIRCERR = 1 THEN
  768.             D#(CIRC, 1) = 1
  769.             D#(CIRC, 2) = 3
  770.             ER = 1
  771.             GOTO CIRCUM3
  772.         END IF
  773. '***** 最大値を越える計算エラーを予防する *****
  774.         IF LOG(1.79769313486231D+308) < ABS(SSUBTOTAL#) * LOG(ABS(D#(CIRC, 0))) THEN
  775.             COLOR 4
  776.             PRINT SPC(15); "《 べき乗数値が大きすぎます！ 修正してください。》"
  777.             D#(CKCIRC, 1) = 1
  778.             D#(CKCIRC, 2) = 3
  779.             ER = 1
  780.             CIRCERR = 0
  781.             COLOR 7
  782.             GOTO CIRCUM3
  783.         END IF
  784.         ON ERROR GOTO ERRLOOP '***** 計算する *****
  785.         SSUBTOTAL# = D#(CIRC, 0) ^ SSUBTOTAL#
  786.         D#(CIRC, 1) = 1
  787.         CKCIRC = CKCIRC + 1
  788. CIRCUM3:
  789.         IF D#(CIRC, 0) = 1 THEN
  790.             CKCIRC = 0
  791.         ELSE
  792.             CKCIRC = CIRC
  793.         END IF
  794. CIRCUM4:
  795.     NEXT CIRC
  796. RETURN
  797. CALC: '***** 式計算ルーチン *****
  798.     FOR COUNT = 0 TO CLMAX
  799.         IF COUNT = CLMAX THEN
  800.             FLAGON = 0
  801.             FLAGOFF = PARTS + 1
  802.             GOTO CALCJP2
  803.         END IF
  804.         FOR C = 0 TO PARTS
  805.             IF D#(C, 1) = 1 THEN GOTO CALCJP1
  806.             IF CAL%(C) = 10 THEN FLAGON = C
  807.             IF CAL%(C) = -10 AND FLAGON <> 0 THEN
  808.                 FLAGOFF = C
  809.                 GOTO CALCJP2
  810.             END IF
  811. CALCJP1:
  812.         NEXT C
  813. CALCJP2:
  814.     TOTAL# = 0
  815.     C = FLAGON
  816.     GOSUB CIRCUM
  817.     SUBTOTAL# = SSUBTOTAL#
  818.     FOR C = FLAGON + 1 TO FLAGOFF - 1
  819.         ON ERROR GOTO ERRLOOP
  820.         IF D#(C, 1) = 1 THEN GOTO CALCJP3
  821.         GOSUB CIRCUM
  822.         IF CAL%(C) = 1 THEN SUBTOTAL# = SUBTOTAL# * SSUBTOTAL#
  823.         IF CAL%(C) = 2 THEN
  824.             IF SSUBTOTAL# = 0 THEN
  825.                 D#(C, 1) = 1
  826.                 D#(C, 2) = 3
  827.                 ER = 1
  828.             ELSE
  829.                 SUBTOTAL# = SUBTOTAL# / SSUBTOTAL#
  830.             END IF
  831.         END IF
  832.         IF CAL%(C) = 3 THEN
  833.             TOTAL# = TOTAL# + SUBTOTAL#
  834.             SUBTOTAL# = SSUBTOTAL#
  835.         END IF
  836.         IF CAL%(C) = 4 THEN
  837.             TOTAL# = TOTAL# + SUBTOTAL#
  838.             SUBTOTAL# = -SSUBTOTAL#
  839.         END IF
  840.         C = ENDCIRC
  841. CALCJP3:
  842.     NEXT C
  843.     TOTAL# = TOTAL# + SUBTOTAL#
  844.     IF -10 ^ -15 < TOTAL# AND TOTAL# < 10 ^ -15 THEN TOTAL# = 0
  845.     IF COUNT = CLMAX THEN GOTO CALCJP4
  846.     D#(FLAGON - 1, 0) = TOTAL#
  847.     D#(FLAGON, 1) = 1
  848.     D#(FLAGOFF, 1) = 1
  849. CALCJP4:
  850.     NEXT COUNT
  851. '    PRINT FLAGON;FLAGOFF '************ CHECK *************
  852. '    FOR C=0 TO PARTS
  853. '        PRINT USING"###";C;
  854. '        PRINT USING "######   "; CAL%(C);
  855. '        PRINT USING "&           &"; P$(C);
  856. '        PRINT USING "######"; D#(C, 0);
  857. '        PRINT USING "######"; D#(C, 1);
  858. '        PRINT USING "######"; D#(C, 2)
  859. '    NEXT C '**********************************************
  860. RETURN
  861. '********************** 計算結果表示ルーチン ************************
  862. SUBPRT: '***** 計算経過出力 *****
  863.     ON ERROR GOTO ERRLOOP
  864.     PRINT "　　　＝";
  865.     FOR C = 0 TO PARTS
  866.         IF CAL%(C) = 1 THEN PRINT "*";
  867.         IF CAL%(C) = 2 THEN PRINT "/";
  868.         IF CAL%(C) = 3 THEN PRINT "+";
  869.         IF CAL%(C) = 4 THEN PRINT "-";
  870.         IF CAL%(C) = 5 THEN PRINT "^";
  871.         IF CAL%(C) = 10 THEN PRINT "[";
  872.         IF CAL%(C) = -10 THEN PRINT "]";
  873.         IF CAL%(C) <> -10 THEN
  874.             COLOR 7 - D#(C, 2)
  875.             PRINT D#(C, 0);
  876.         END IF
  877.         COLOR 7
  878.     NEXT C
  879.     PRINT
  880. RETURN
  881. OUTP: '***** 計算結果出力 *****
  882.     ON ERROR GOTO ERRLOOP
  883.     PRINT "　　　＝";
  884.     IF ER <> 0 THEN
  885.         COLOR 4
  886.         PRINT "ERROR"
  887.         COLOR 7
  888.         GOTO OPJP
  889.     END IF
  890.     PRINT TOTAL#
  891.     STOTAL# = TOTAL#
  892.     IF ABS(TOTAL#) > 4294967295# OR TOTAL# <> INT(TOTAL#) THEN
  893.         IF TOTAL# < 0 THEN
  894.             PRINT "      ＜ ";
  895.         ELSE
  896.             PRINT "      ＞ ";
  897.         END IF
  898.     ELSE
  899.         PRINT "      ＝ ";
  900.     END IF
  901.     IF TOTAL# < 0 THEN
  902.         PRINT "- ";
  903.     ELSE
  904.         PRINT "  ";
  905.     END IF
  906.     IF ABS(STOTAL#) > 4294967295# THEN STOTAL# = 4294967295#
  907.     SHIN# = 16
  908. CHSTART:
  909.         CONVOUT$ = ""
  910.         A# = ABS(STOTAL#)
  911.         C# = 8
  912.         DCK = 0
  913. HSHIN:
  914.         IF C# < 0 THEN GOTO HSHINOUT
  915.         SUBA# = INT(A# / SHIN# ^ C#)
  916.         IF 0 < SUBA# AND DCK = 0 THEN DCK = 1
  917.         IF 9 < SUBA# THEN
  918.             CONVOUT$ = CONVOUT$ + CHR$(&H41 + SUBA# - 10)
  919.         ELSE
  920.             IF DCK = 1 THEN
  921.                 CONVOUT$ = CONVOUT$ + RIGHT$(STR$(SUBA#), 1)
  922.             ELSE
  923.                 CONVOUT$ = CONVOUT$ + "0"
  924.             END IF
  925.         END IF
  926.         A# = A# - INT(A# / SHIN# ^ C#) * SHIN# ^ C#
  927.         C# = C# - 1
  928.         GOTO HSHIN
  929. HSHINOUT:
  930.     PRINT RIGHT$("00000000" + CONVOUT$, 8); " h";
  931.     PRINT " ＝ ";
  932.     A# = ABS(STOTAL#)
  933.     C# = 31
  934.     IF TOTAL# < 0 THEN
  935.         PRINT "- ";
  936.     ELSE
  937.         PRINT "  ";
  938.     END IF
  939. NISHIN:
  940.     IF C# < 0 THEN
  941.         PRINT "( 2)"
  942.         GOTO OPJP
  943.     ELSE
  944.         PRINT USING "#"; INT(A# / 2 ^ C#);
  945.         PRINT NISHIN$(C#);
  946.         A# = A# - INT(A# / 2 ^ C#) * 2 ^ C#
  947.         C# = C# - 1
  948.         GOTO NISHIN
  949.     END IF
  950. OPJP:
  951.     COLOR 5
  952.     IF CLASS < 0 THEN
  953.         PRINT "〔(〕が"; -CLASS; "個足りません｡"
  954.     ELSE
  955.         IF CLASS > 0 THEN PRINT "〔)〕が"; CLASS; "個足りません｡"
  956.     END IF
  957. RETURN
  958. CONVOUT: '***** 3～15進数計算結果出力 *****
  959.     IF ER <> 0 THEN RETURN
  960.     CSRX% = POS(0)
  961.     CSRY% = CSRLIN
  962.     COLOR 6
  963.     PRINT "     《 計算結果を他の進数で表示しますか。【 ＹＥＳ→実行・ＮＯ→取消 】》"
  964.     IF 22 < CSRY% THEN CSRY% = 22
  965. SCVO:
  966.     S$ = INKEY$
  967.     GOSUB PANEL
  968.     IF S$ = "" THEN GOTO SCVO
  969.     IF S$ = "N" OR S$ = "n" OR S$ = CHR$(24) OR S$ = CHR$(27) THEN
  970.         LOCATE CSRY%, CSRX%
  971.         COLOR 7
  972.         PRINT SPACE$(80);
  973.         LOCATE CSRY%, CSRX%
  974.         RETURN
  975.     END IF
  976.     IF S$ = "Y" OR S$ = "y" OR S$ = CHR$(13) THEN
  977.         LOCATE CSRY%, CSRX%
  978.         COLOR 7
  979.         PRINT SPACE$(80);
  980.         LOCATE CSRY%, CSRX%
  981.     ELSE
  982.         GOTO SCVO
  983.     END IF
  984.     SHIN# = 3
  985. CVOSTART:
  986.         CONVOUT$ = ""
  987.         A# = ABS(STOTAL#)
  988.         C# = 20
  989.         DCK = 0
  990.         COLOR 7
  991.         PRINT "　　　＝ ";
  992. TASHIN:
  993.         IF C# < 0 THEN GOTO CVOJP
  994.         SUBA# = INT(A# / SHIN# ^ C#)
  995.         IF 0 < SUBA# AND DCK = 0 THEN
  996.             DCK = 1
  997.             IF TOTAL# < 0 THEN
  998.                 CONVOUT$ = CONVOUT$ + "-"
  999.             ELSE
  1000.                 CONVOUT$ = CONVOUT$ + " "
  1001.             END IF
  1002.         END IF
  1003.         IF 9 < SUBA# THEN
  1004.             CONVOUT$ = CONVOUT$ + CHR$(&H41 + SUBA# - 10)
  1005.         ELSE
  1006.             IF DCK = 1 THEN
  1007.                 CONVOUT$ = CONVOUT$ + RIGHT$(STR$(SUBA#), 1)
  1008.             ELSE
  1009.                 CONVOUT$ = CONVOUT$ + " "
  1010.             END IF
  1011.         END IF
  1012.         A# = A# - INT(A# / SHIN# ^ C#) * SHIN# ^ C#
  1013.         C# = C# - 1
  1014.         GOTO TASHIN
  1015. CVOJP:
  1016.         IF DCK = 0 THEN CONVOUT$ = "                     0"
  1017.         PRINT CONVOUT$;
  1018.         IF SHIN# = INT(SHIN# / 2) * 2 THEN
  1019.             PRINT USING "(##)"; SHIN#
  1020.         ELSE
  1021.             PRINT USING "(##)"; SHIN#;
  1022.         END IF
  1023.         SHIN# = SHIN# + 1
  1024.     IF SHIN# < 16 THEN GOTO CVOSTART
  1025.     PRINT
  1026. RETURN
  1027. '*********************** エラー処理ルーチン *************************
  1028. ERRLOOP:
  1029.     IF ERR = 6 THEN
  1030.         COLOR 4
  1031.         PRINT SPC(18); "《 数値が大きすぎます！ 修正してください。》"
  1032.     ELSE
  1033.         GOTO EJP1
  1034.     END IF
  1035.     D#(CIRC, 2) = 3
  1036.     ER = 1
  1037.     CIRCERR = 1
  1038.     COLOR 7
  1039.     'GOSUB SUBPRT
  1040.     RESUME NEXT
  1041. EJP1:
  1042.     IF ERR = 5 THEN
  1043.         COLOR 3
  1044.         PRINT SPC(20); "《 虚数を含みます！ 修正してください。》"
  1045.     ELSE
  1046.         GOTO EJP2
  1047.     END IF
  1048.     D#(CIRC, 1) = 1
  1049.     D#(CIRC, 2) = 4
  1050.     ER = 1
  1051.     CIRCERR = 1
  1052.     COLOR 7
  1053.     'GOSUB SUBPRT
  1054.     RESUME CIRCUM3
  1055. EJP2:
  1056.     PRINT
  1057.     COLOR 4
  1058.     PRINT SPC(20); "《 対応できないエラーです。ごめんなさい。》"
  1059.     PRINT SPC(29); "line"; ERL; "  error no."; ERR
  1060. ESTOP2:
  1061.     E$ = INKEY$
  1062.     IF E$ = "" THEN GOTO ESTOP2
  1063.     RESUME MAIN
  1064. RECERR: '***************************
  1065.     IF EP = 1 THEN GOTO RECPASS
  1066.     IF EP = 2 THEN RESUME NEXT
  1067. FOPEN: '***** ファイルオープンユニット ************
  1068. 'I   DIR$   : ディレクトリ 例 A:\DIR\DIR\ ※[\]必須
  1069. 'I   FILE$  : ファイル名
  1070. 'I   FTYPE% : ファイルオープンタイプ(I=1, O=2, R=4, A=8, B=32, ELSE END SUB)
  1071. 'I   RECLEN : レコード長(デフォルトは (S)512Byte, (R)128Byte。(B)不用)
  1072. 'O   FONO%  : ファイルオープン番号(自動発生)
  1073. 'O   DNOMAX : RANDOMオープン時のデータ記録数
  1074. 'O   EP%    : エラーポイント
  1075. 'O   EP$    : エラーメッセージ
  1076. '**************** ユニット内ラベル ****************
  1077. 'FOPEN:     : ファイルオープンユニット・メインラベル
  1078. 'ERRFMAKE:  : ルート・ディレクトリ設定
  1079. 'ERRFCK:    : ディレクトリ検査・作成
  1080. 'ERRFOUT:   : ファイル作成・オープン
  1081. 'ERRFOPEN:  : エラー処理ルーチン
  1082. 'EOFOPEN:   : ユニット終了
  1083. '**************************************************
  1084.     FONO% = FREEFILE
  1085.     DNOMAX = 0
  1086.     EP$ = ""
  1087.     EP% = 1
  1088.         ON ERROR GOTO ERRFOPEN
  1089.         SELECT CASE FTYPE%
  1090.         CASE 1
  1091.             IF RECLEN < 1 OR 32767 < RECLEN THEN RECLEN = 512
  1092.             OPEN DIR$ + FILE$ FOR INPUT AS FONO% LEN = RECLEN
  1093.         CASE 2
  1094.             IF RECLEN < 1 OR 32767 < RECLEN THEN RECLEN = 512
  1095.             OPEN DIR$ + FILE$ FOR OUTPUT AS FONO% LEN = RECLEN
  1096.         CASE 4
  1097.             IF RECLEN = 0 OR 32767 < RECLEN THEN RECLEN = 128
  1098.             OPEN DIR$ + FILE$ FOR RANDOM AS FONO% LEN = RECLEN
  1099.             DNOMAX = LOF(FONO%) \ RECLEN
  1100.         CASE 8
  1101.             IF RECLEN = 0 OR 32767 < RECLEN THEN RECLEN = 512
  1102.             OPEN DIR$ + FILE$ FOR APPEND AS FONO% LEN = RECLEN
  1103.         CASE 32
  1104.             OPEN DIR$ + FILE$ FOR BINARY AS FONO%
  1105.         END SELECT
  1106.     EP% = 0
  1107.     GOTO EOFOPEN
  1108.  
  1109. ERRFMAKE:
  1110.     SHELL LEFT$(DIR$, 2)
  1111. '   ***** 拡張 *****
  1112.     IF RIGHT$(EP$, 2) = "71" THEN
  1113. RECPASS:
  1114.         COLOR 3
  1115.         LOCATE 13, 3
  1116.         PRINT "《Ａドライブのデータフロッピーが不備です。計算式の記録・再生は行いません。》";
  1117.         VALCREC% = 1
  1118.         C = 0
  1119. RECPASSL:
  1120.         IF 500 < C THEN GOTO START
  1121.         GOSUB PANEL
  1122.         I$ = INKEY$
  1123.         C = C + 1
  1124.         IF I$ <> "" THEN C = 500
  1125.         GOTO RECPASSL
  1126.     END IF
  1127.     CHDIR "\"
  1128.     DIRPTR% = 4
  1129. ERRFCK:
  1130.     EP% = 2
  1131.         ON ERROR GOTO ERRFOPEN
  1132.         IF INSTR(DIRPTR%, DIR$, "\") = 0 THEN GOTO ERRFOUT
  1133.         MKDIR LEFT$(DIR$, INSTR(DIRPTR%, DIR$, "\") - 1)
  1134.         DIRPTR% = INSTR(DIRPTR%, DIR$, "\") + 1
  1135.         GOTO ERRFCK
  1136. ERRFOUT:
  1137.     EP% = 0
  1138.         SELECT CASE FTYPE%
  1139.         CASE 2
  1140.             IF RECLEN < 1 OR 32767 < RECLEN THEN RECLEN = 512
  1141.             OPEN DIR$ + FILE$ FOR OUTPUT AS FONO% LEN = RECLEN
  1142.         CASE 4
  1143.             IF RECLEN = 0 OR 32767 < RECLEN THEN RECLEN = 128
  1144.             OPEN DIR$ + FILE$ FOR RANDOM AS FONO% LEN = RECLEN
  1145.             DNOMAX = LOF(FONO%) \ RECLEN
  1146.         CASE 8
  1147.             IF RECLEN = 0 OR 32767 < RECLEN THEN RECLEN = 512
  1148.             OPEN DIR$ + FILE$ FOR OUTPUT AS FONO% LEN = RECLEN
  1149.         CASE 32
  1150.             OPEN DIR$ + FILE$ FOR BINARY AS FONO%
  1151.         END SELECT
  1152.     GOTO EOFOPEN
  1153.  
  1154. ERRFOPEN:
  1155.     SELECT CASE EP%
  1156.     CASE 1
  1157.         EP$ = "指定のファイルが見つかりませんでした。" + STR$(ERR)
  1158.         RESUME ERRFMAKE
  1159.     CASE 2
  1160.         EP$ = "指定のファイルがオープンできませんでした。"
  1161.         RESUME RECPASS
  1162.     CASE ELSE
  1163.         EP$ = "予測していなかったFOPENエラーです。"
  1164.         PRINT
  1165.         PRINT EP$
  1166.         RESUME RECPASS
  1167.     END SELECT
  1168.  
  1169. EOFOPEN:
  1170.     ON ERROR GOTO 0
  1171. RETURN
  1172. '**************************************************
  1173.  
  1174.  
  1175.  
  1176.